perm filename SMOOTH.OLD[MSS,LCS] blob sn#103261 filedate 1974-10-22 generic text, type T, neo UTF8
00010		SUBROUTINE SMOOTH(JQ)
00020		COMMON/ED/KX,NEXT,NN,NX,NY,J/LL/L
00050		COMMON /RC/MCLEF(400),IST(4000)
00060		COMMON /RZ/RSZ,IPLT,RJB,CENTR
00080		COMMON /FL/IC,NJ,NQ,RZ,IXRX,XGP,RXGP
00100		DIMENSION BUF2(700),SX(512),SY(512)
00105		COMMON/NFF/NE(513)
00110		DATA INC/10/
00120		RR=RSZ
00130	CC	IF(IPLT.EQ.0)RR=RR*1.7
00200		COMMON X(100),Y(100),N,X1(512),Y1(512),S(100),K
00202		IF(IPLT.EQ.0.AND.JQ.EQ.0)CALL DPYSET(1,IST,4000)
00205		IF(JQ.NE.' ')CALL HYDPOG(1)
00210		JL=0
00220		NOFIL=-1
00225		IF(JQ.EQ.0)NOFIL=0
00230	100	JY=2
00300		IF(IPLT.EQ.0)CALL DPYSET(3,BUF2,700)
00305		J=MCLEF(1)
00310	7	JX=J
00320	8	KX=0
00400		DO 1 K=JY,J
00600		CALL UNPACK(K,JA,JB,MCLEF)
00602		IF(L.GE.100000000.AND.K.GT.JY)GO TO 6
00603	C  JUMP WHEN INVIS. VECT.
00605		KX=KX+1
00610		X(KX)=JA+RJB
00620	1	Y(KX)=JB+CENTR
00630	9	X(KX+1)=999.
01300	4	N=KX
01900		CALL SS
02075		JL=JL+1
02077		JK=JL
02080		SX(JL)=X1(1)*RR
02085		SY(JL)=Y1(1)*RR
02100		CALL LINES(X1(1),Y1(1),3)
02200		DO 5 K=2,512,INC
02210		JL=JL+1
02255		SX(JL)=X1(K)*RR
02277		SY(JL)=Y1(K)*RR
02300		NE(JL)=0
02350	5	CALL LINES(X1(K),Y1(K),2)
02353		IF(SX(JL).NE.SX(JK))SX(JK)=SX(JL)
02356		IF(SY(JL).NE.SY(JK))SY(JK)=SY(JL)
02360		NE(JK)=3
02380	C FOR INVIS. VECTOR
02400		IF(IPLT.EQ.0)CALL DPYOUT(3)
02406	10	IF(JX.NE.J)GO TO 7
02420		CALL SETPOG(1)
02500		IF(NOFIL)RETURN
02600	200	NE(1)=JL
02800		CALL FILLQ(SX,SY,NE)
03000		RETURN
05200	6	JY=K
05300		JX=JY
05400		GO TO 9
05500		END
05600	
05700		SUBROUTINE EDTYP(K,X,Y,JJJ)
05800		TYPE 57
05900		ACCEPT 1,K,X,Y
06000		IF(K.NE.' ')JJJ=0
06100		IF(K.EQ.':'.OR.JJJ)GO TO 2
06200	C  TYPE "A" OR ":" TO ALTER
06300		IF(K.NE.'G')RETURN
06400		JJJ=-1
06500	2	K='A'
06700	57	FORMAT(' TYPE D, A, I OR X ',$)
06750	C  M  N1, N2  =  MOVE SEGS N1 THROUGH N2.
06800	1	FORMAT(A1,2F)
06900		END
07000	
07100		SUBROUTINE ITYP
07110		COMMON /RZ/RSZ,IPLT,RJB,CENTR
07200		COMMON/ED/K,NEXT,NN,NX,NY,J
07210		A=STPT(FLOAT(NX),RJB)
07220		B=STPT(FLOAT(NY),CENTR)
07300		TYPE 1,NN,A,B
07500	1	FORMAT(I4,')',2F6.0)
07600		END
07700	
07800		SUBROUTINE FILLQ(Q,R,N)
07900		DIMENSION Q(1),R(1),N(1)
07955		COMMON /RZ/RSZ,IPLT,RJB,CENTR
08000		M=6
08100		IF(IPLT)M=1
08200	1	RZ=RSZ
08250		RSZ=1.0
08300	CC	IF(IPLT.EQ.0)RSZ=1./1.7
08400		CALL FILLER(Q,R,N,M)
08500		RSZ=RZ
08510		IF(IPLT.GE.0)CALL DPYOUT(1)
08600		END
09000		
09100		SUBROUTINE SAVE(M)
09200		DIMENSION M(1)
09300		J=7
09400		L=8
09500		DO 12 K=1,M(1),8
09600		IF(K+J.LT.M(1))GO TO 12
09700		J=M(1)-K
09800		L=J+1
09900	12	WRITE(1,11)L,(M(NM),NM=K,K+J)
10000		RETURN
10100	11	FORMAT(' 9999',I3,8I10)
10200		END